home *** CD-ROM | disk | FTP | other *** search
/ An Invitation to the Roland World of Music / Roland - An Invitation To The Roland World Of Music.bin / vb / vb30 / disk1 / ole2mod2.ba_ / ole2mod2.bin
Text File  |  1993-04-27  |  3KB  |  119 lines

  1. Option Explicit
  2.  
  3. Global MDINew As Integer
  4.  
  5. Sub NewObject ()
  6.   MDINew = True
  7.   NewOleForm
  8.   If MDIfrm.ActiveForm.Ole1.OLEType <> OLE_NONE Then
  9.     MDIfrm.ActiveForm.Ole1.Action = OLE_ACTIVATE
  10.   Else
  11.     Unload MDIfrm.ActiveForm
  12.   End If
  13. End Sub
  14.  
  15. Sub NewOleForm ()
  16. Dim Newform As New frmOLE
  17. Newform.Show
  18. UpdateCaption
  19. End Sub
  20.  
  21. Sub OpenObject ()
  22.   MDINew = False
  23.   NewOleForm
  24.   OpenSave ("Open")
  25.   If MDIfrm.ActiveForm.Ole1.OLEType = OLE_NONE Then
  26.     Unload MDIfrm.ActiveForm
  27.   End If
  28. End Sub
  29.  
  30. Sub OpenSave (Action As String)
  31. Dim Filenum
  32. Filenum = FreeFile
  33.  
  34.  
  35.   ' Set common dialog options.
  36.   MDIfrm.ActiveForm.CMDialog1.Filter = "OLE 2.0 Objects|*.OLE"
  37.   MDIfrm.ActiveForm.CMDialog1.FilterIndex = 1
  38.   
  39.   MDIfrm.ActiveForm.Ole1.FileNumber = Filenum
  40.  
  41. On Error Resume Next
  42.  
  43. Select Case Action
  44. Case "Save"
  45.   ' Display Save As dialog.
  46.   MDIfrm.ActiveForm.CMDialog1.Action = 2
  47.   If Err Then
  48.     ' user pressed cancel
  49.     If Err = 32755 Then
  50.       Exit Sub
  51.     Else
  52.       MsgBox "An unanticipated error occured with the Save As dialog."
  53.     End If
  54.   End If
  55.   ' Open and save the file.
  56.   Open MDIfrm.ActiveForm.CMDialog1.Filename For Binary As Filenum
  57.   If Err Then
  58.     MsgBox (Error)
  59.     Exit Sub
  60.   End If
  61.   MDIfrm.ActiveForm.Ole1.Action = OLE_SAVE_TO_FILE
  62.   If Err Then MsgBox (Error)
  63.  
  64. Case "Open"
  65.   ' Display File Open dialog.
  66.   MDIfrm.ActiveForm.CMDialog1.Action = 1
  67.   If Err Then
  68.     ' user pressed cancel
  69.     If Err = 32755 Then
  70.       Exit Sub
  71.     Else
  72.       MsgBox "An unanticipated error occured with the Open As dialog."
  73.     End If
  74.   End If
  75.   ' Open the file.
  76.   Open MDIfrm.ActiveForm.CMDialog1.Filename For Binary As Filenum
  77.   If Err Then
  78.     Exit Sub
  79.   End If
  80.   ' Display hourglass.
  81.   Screen.MousePointer = 11
  82.   MDIfrm.ActiveForm.Ole1.Action = OLE_READ_FROM_FILE
  83.   If (Err) Then
  84.     If Err = 30015 Then
  85.       MsgBox "Not a valid OLE object."
  86.     Else
  87.       MsgBox Error$
  88.     End If
  89.     Unload MDIfrm.ActiveForm
  90.   End If
  91.  
  92.   ' Set form properties now that OLE control contains an object.
  93.   UpdateCaption
  94.   ' Restore mouse pointer.
  95.   Screen.MousePointer = 0
  96. End Select
  97.   
  98. Close Filenum
  99. End Sub
  100.  
  101. Sub UpdateCaption ()
  102.   Dim Verb
  103.   ' Set Form properties now that it contains an object.
  104.   MDIfrm.ActiveForm.Caption = MDIfrm.ActiveForm.Ole1.Class + " Object"
  105.   MDIfrm.ActiveForm.mnuObject.Caption = MDIfrm.ActiveForm.Ole1.Class + " " + MDIfrm.ActiveForm.mnuObject.Caption
  106.  
  107.   On Error Resume Next
  108.   For Verb = 1 To VerbMax
  109.     Load MDIfrm.ActiveForm.mnuVerbs(Verb)
  110.     If Err = 360 Then ' Object already loaded.
  111.       Unload MDIfrm.ActiveForm.mnuVerbs(Verb)
  112.       Load MDIfrm.ActiveForm.mnuVerbs(Verb)
  113.       Err = 0
  114.     End If
  115.   Next Verb
  116.   MDIfrm.ActiveForm.mnuVerbs(0).Visible = False
  117. End Sub
  118.  
  119.